home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
clp123.zip
/
123.PRG
next >
Wrap
Text File
|
1992-05-25
|
7KB
|
237 lines
/*
█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
█ █
█ MODULE : 123.prg █
█ AUTHOR : jON Rowlan S.A.D.S. Ltd. 1989, 1990, 1991 █
█ Hunton, Maidstone England 44 6272 688/748 █
█ (from 28/05/92 0622 820688 & 820748 ) █
█ Compuserve : 100013,475 █
█ █
█ PARAMETERS : none █
█ █
█ description : This is a self contained module that will create a Lotus █
█ WKS/WK1 style spreadsheet from an array of character and █
█ numeric data. Numerics are converted to the IEEE format as █
█ used by Lotus. I would be pleased to hear of any enhancements █
█ comments or :-( 'BUGS' but if the module is used in any █
█ application the copyright notice as bordered by this box must █
█ be included in the source. If any modifications are required █ █
█ I will be happy to do these for 'The usual fee plus expenses'. █
█ At the end of the day, I will be happy if this module helps █
█ save somebody the hassle I had in trying to put it together █
█ when asked by my client, "Can we export to Lotus ???!!???". █
█ The IEEE conversion routine can be reworked with Funcky's █
█ or() and and() functions. Bon Chance! █
█ █
█ Compile with : /n █
█ █
█ Link with : whatever you fancy █
█ █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█*/
#define WKS_BOF chr(0)+chr(0)+chr(2)+chr(0)+chr(4)+chr(4)
#define WKS_EOF chr(1)+chr(0)+chr(0)+chr(0)
#define WKS_LABELHDR chr(15)+chr(0)
#define WKS_NUMBERHDR chr(14)+chr(0)+chr(13)+chr(0)
#define LEFT_JUSTIFY "'"
#define RIGHT_JUSTIFY chr(34)
#define CENTERED "^"
#define REPEATING "\"
#define PROTECTED chr(128)
#define UNPROTECTED chr(0)
#define FIXED 0
#define SCIENTIFIC 1
#define CURRENCY 2
#define PERCENT 3
#define COMMA 4
#define UNUSED1 5
#define UNUSED2 6
#define SPECIAL 7
#define STANDARD_FORMAT chr(255)
#command CLOSE WORKSHEET => fwrite( WKSHandle, WKS_EOF ) ; fclose( WKSHandle )
#command CREATE WORKSHEET <(worksheetname)> FROM ARRAY <arrayname> => ;
WKScreate( <(worksheetname)>, @<arrayname> )
#command CREATE WORKSHEET <worksheetname> => ;
WKSHandle := fcreate( <worksheetname> ) ;;
fwrite( WKSHandle, WKS_BOF )
STATIC WKSHandle
FUNCTION WKSexample()
LOCAL worksheet:={ { "Year", "Premiums" }, ;
{ 1978, 15526, 26625, -9918, 128827, 12762, 187 }, ;
{ 1979, 16651, -900, 12772, 91881, -1298222 }, ;
{ 1980, 177111, 19918, -18716, 1222 }, ;
{ 1981, 12650932, 18827, 998 }, ;
{ 1982, 166154, 12 }, ;
{ 1983, 1652, 15 }, ;
{ 1984, 1.87, .7 }, ;
{ 1985, 0.27 } }
CREATE WORKSHEET lotus FROM ARRAY worksheet
?"Done."
return( NIL )
FUNCTION WKSCreate( WKSFileName, WorkSheet )
LOCAL col, row
// Create WKS type file //
if !( "." $ WKSFileName )
WKSFileName := WKSFileName+".WKS"
endif
CREATE WORKSHEET WKSFileName
for row=1 to len(WorkSheet)
for col=1 to len(WorkSheet[row])
do case
case valtype( worksheet[row,col] ) == "C"
WKSWriteStr( WorkSheet[row, col], "L", row, col )
case valtype( worksheet[row,col] ) == "N"
WKSWriteNum( WorkSheet[row, col], row, col )
endcase
next
next
CLOSE WORKSHEET
return( NIL )
FUNCTION WKSwritestr( ostr, just, row, col )
LOCAL r
just := upper( just )
ostr := trim( ostr )
// if ostr is blank, return //
if ostr == ""
return( .t. )
endif
// Text label header, 2 chars //
r := fwrite( WKSHandle, WKS_LABELHDR )
// Text Label length, 2 chars //
r := r + fwrite( WKSHandle, chr( ( len( trim( ostr ) ) + 7 ) % 256 ) )
r := r + fwrite( WKSHandle, chr( ( len( trim( ostr ) ) + 7 ) / 256 ) )
// default cell format, 1 char //
r := r + fwrite( WKSHandle, STANDARD_FORMAT )
// cell co-ordinates, 4 chars total ( numbers in reverse byte format ! ) //
r := r + WKScoord( row, col )
// Justification, 1 char //
do case
case just == "R"
r := r + fwrite( WKSHandle, RIGHT_JUSTIFY )
case just == "L"
r := r + fwrite( WKSHandle, LEFT_JUSTIFY )
case just == "C"
r := r + fwrite( WKSHandle, CENTERED )
case just == "R"
r := r + fwrite( WKSHandle, REPEATING )
endcase
// actual textual string, len(ostr) chars //
r := r + fwrite( WKSHandle, ostr, len(ostr) )
// Null termination, 1 char //
r := r + fwrite( WKSHandle, chr(0), 1)
return( r == 11+len(ostr) )
FUNCTION WKSwritenum( num, row, col )
LOCAL r:=0
// Number Cell Header, 4 chars //
r := fwrite( WKSHandle, WKS_NUMBERHDR )
// cell format, 1 char //
r := r + fwrite( WKSHandle, STANDARD_FORMAT )
// Worksheet Co-Ordinates, 4 chars //
r := r + WKScoord( row, col )
// Number converted to an ieee format, 8 chars //
r := r + fwrite( WKSHandle, dec2ieee( num ) )
return( r == 17 )
FUNCTION WKScoord( row, col )
LOCAL r:=0
r := fwrite( WKSHandle, chr( col-1 )+chr(0)+chr( row-1 )+chr(0) )
return( r )
FUNCTION dec2ieee( num )
LOCAL ieeea := { 0, 0, 0, 0, 0, 0, 0, 0 }, F, exponent, e1, e2, e3, ;
sign, i, part
if num != 0
sign := if(num<0, 1, 0)
if sign != 0
num := num * -1
endif
if log(num)/log(2)<0
exponent:=int(log(num)/log(2)-1)+1023
else
exponent:=int(log(num)/log(2))+1023
endif
F := ( num / 2^(exponent-1023) - 1 ) * 2^52
// save exponent //
e1 := int(exponent/256)
e2 := int((exponent-e1*256)/16)
e3 := exponent-e1*256-e2*16
ieeea[8] := (sign*128)+e1*16+e2
ieeea[7] := e3*16
// save fraction //
for i=6 to 0 step -1
part := int( F / 256^i )
ieeea[i+1] := ieeea[i+1] + part
F := F-part*256^i
next
endif
RETURN( chr(ieeea[1])+chr(ieeea[2])+chr(ieeea[3])+chr(ieeea[4])+ ;
chr(ieeea[5])+chr(ieeea[6])+chr(ieeea[7])+chr(ieeea[8]) )